home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / pcboard / dp-nws13.zip / NEWS.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1996-11-14  |  8KB  |  487 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.O1 (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Integer  INTEGER001
  21.     Integer  INTEGER002
  22.     Integer  INTEGER003
  23.     Integer  INTEGER004
  24.     Integer  INTEGER005
  25.     Integer  INTEGER006
  26.     Integer  INTEGER007
  27.     Integer  INTEGER008
  28.     Integer  INTEGER009
  29.     Integer  INTEGER010
  30.     Integer  INTEGER011
  31.     Integer  INTEGER012
  32.     Integer  INTEGER013
  33.     Integer  INTEGER014
  34.     Integer  INTEGER015
  35.     Integer  INTEGER016
  36.     Integer  INTEGER017
  37.     Integer  INTEGER018
  38.     Integer  INTEGER019
  39.     String   TSTRING001(999)
  40.     String   TSTRING002(999)
  41.     String   TSTRING003(999)
  42.     String   STRING004
  43.     String   STRING005
  44.     String   STRING006
  45.     String   STRING007
  46.     String   STRING008
  47.     String   STRING009
  48.     String   STRING010
  49.     String   STRING011
  50.     String   STRING012
  51.     String   TSTRING013(999)
  52.     String   TSTRING014(999)
  53.     String   TSTRING015(999)
  54.     String   TSTRING016(999)
  55.     String   TSTRING017(999)
  56.     String   STRING018
  57.     String   STRING019
  58.     String   STRING020
  59.  
  60. ;------------------------------------------------------------------------------
  61.  
  62.     INTEGER005 = 0
  63.     INTEGER004 = 1
  64.     INTEGER006 = 0
  65.     INTEGER008 = 0
  66.     INTEGER007 = 0
  67.     INTEGER009 = 0
  68.     INTEGER010 = 0
  69.     INTEGER001 = 0
  70.     INTEGER002 = 0
  71.     INTEGER011 = 0
  72.     INTEGER012 = 0
  73.     Goto LABEL001
  74.     SPrintLn "Joo kyllä sä tuneri osaat itekin PPEitä koodata... Sitäpaitsi"
  75.     SPrintLn "on harvinaisen törkeää purkaa toisten PPEitä................."
  76.     SPrintLn ".....ja poistaa niistä toisten (c)opyright -merkinnät........"
  77.     :LABEL001
  78.     STRING009 = Date()
  79.     INTEGER005 = 2
  80.     INTEGER004 = 1
  81.     BOOLEAN001 = 0
  82.     INTEGER001 = 0
  83.     Cls
  84.     FOpen 1, PPEPath() + "news.cfg", 0, 0
  85.     FGet 1, STRING010
  86.     FGet 1, STRING019
  87.     FGet 1, STRING020
  88.     FClose 1
  89.     If (Exist(PPEPath() + "news.idx")) Then
  90.         Goto LABEL002
  91.     Else
  92.         PrintLn "@X0C■ No index file, creating a new one@X07"
  93.         FCreate 1, PPEPath() + "news.idx", 1, 0
  94.         FOpen 1, PPEPath() + "news.idx", 0, 0
  95.         FPutLn 1, "DELTAPRODUCTIONS NEWS - v 1.0"
  96.     Endif
  97.     :LABEL002
  98.     STRING006 = U_LDate()
  99.     INTEGER013 = Day(STRING006)
  100.     INTEGER014 = Month(STRING006)
  101.     INTEGER015 = Year(STRING006)
  102.     FOpen 1, PPEPath() + "news.idx", 0, 0
  103.     FGet 1, STRING004
  104.     Newline
  105.     If (STRING004 <> "DELTAPRODUCTIONS NEWS - v 1.0") Then
  106.         PrintLn "@X0C■ NEWS.IDX might be corrupted!@X07"
  107.         Goto LABEL003
  108.     Endif
  109.     :LABEL003
  110.     If (Ferr(1)) Goto LABEL004
  111.     INTEGER001 = INTEGER001 + 1
  112.     FGet 1, TSTRING001(INTEGER001)
  113.     FGet 1, TSTRING002(INTEGER001)
  114.     FGet 1, TSTRING003(INTEGER001)
  115.     Goto LABEL003
  116.     :LABEL004
  117.     STRING008 = INTEGER001
  118.     FClose 1
  119.     For INTEGER002 = 1 To INTEGER001 - 1
  120.         INTEGER016 = Day(TSTRING003(INTEGER002))
  121.         INTEGER017 = Month(TSTRING003(INTEGER002))
  122.         INTEGER018 = Year(TSTRING003(INTEGER002))
  123.         BOOLEAN001 = 0
  124.         If (INTEGER015 < INTEGER018) Then
  125.             BOOLEAN001 = 1
  126.         Endif
  127.         If ((INTEGER014 < INTEGER017) && (INTEGER015 == INTEGER018)) Then
  128.             BOOLEAN001 = 1
  129.         Endif
  130.         If (((INTEGER015 == INTEGER018) && (INTEGER014 == INTEGER017)) && (INTEGER013 <= INTEGER016)) Then
  131.             BOOLEAN001 = 1
  132.         Endif
  133.         If (BOOLEAN001 == 1) Then
  134.             TSTRING017(INTEGER002) = "*"
  135.             Continue
  136.         Endif
  137.         TSTRING017(INTEGER002) = " "
  138.     Next
  139.     STRING005 = String(0)
  140.     If (Len(STRING005) == 1) STRING005 = "00" + STRING005
  141.     If (Len(STRING005) == 2) STRING005 = "0" + STRING005
  142.     INTEGER008 = INTEGER001 - 1
  143.     :LABEL005
  144.     Cls
  145.     PrintLn "@X1F@POFF@DeltaProductions NEWS v1.3A                                  (c) Creep&Delta/DP@X07"
  146.     DispFile PPEPath() + "news", 0
  147.     :LABEL006
  148.     If (INTEGER005 == INTEGER004) INTEGER005 = INTEGER004 + 1
  149.     Print "@X03"
  150.     For INTEGER009 = 1 To 19
  151.         AnsiPos 2, INTEGER009 + 2
  152.         Print " " + Left(TSTRING001(STRING008 - INTEGER009 + INTEGER003), 54) + " "
  153.         AnsiPos 59, INTEGER009 + 2
  154.         Print " " + Left(TSTRING003(STRING008 - INTEGER009 + INTEGER003), 8) + " "
  155.         AnsiPos 70, INTEGER009 + 2
  156.         Print " " + Left(TSTRING002(STRING008 - INTEGER009 + INTEGER003), 3) + " "
  157.         AnsiPos 76, INTEGER009 + 2
  158.         Print " " + Left(TSTRING017(STRING008 - INTEGER009 + INTEGER003), 1) + " "
  159.     Next
  160.     :LABEL007
  161.     If (INTEGER005 == INTEGER004) Goto LABEL008
  162.     AnsiPos 2, INTEGER005 + 2
  163.     Print " " + Left(TSTRING001(STRING008 - INTEGER003 + INTEGER005), 54) + " "
  164.     AnsiPos 2, INTEGER004 + 2
  165.     Print "@X1F " + Left(TSTRING001(STRING008 - INTEGER003 + INTEGER004), 54) + " @X03"
  166.     AnsiPos 70, INTEGER005 + 2
  167.     Print " " + Left(TSTRING002(STRING008 - INTEGER003 + INTEGER005), 3) + " "
  168.     AnsiPos 70, INTEGER004 + 2
  169.     Print "@X1F " + Left(TSTRING002(STRING008 - INTEGER003 + INTEGER004), 3) + " @X03"
  170.     AnsiPos 59, INTEGER005 + 2
  171.     Print " " + Left(TSTRING003(STRING008 - INTEGER003 + INTEGER005), 8) + " "
  172.     AnsiPos 59, INTEGER004 + 2
  173.     Print "@X1F " + Left(TSTRING003(STRING008 - INTEGER003 + INTEGER004), 8) + " @X03"
  174.     AnsiPos 76, INTEGER005 + 2
  175.     Print " " + Left(TSTRING017(STRING008 - INTEGER003 + INTEGER005), 1) + " "
  176.     AnsiPos 76, INTEGER004 + 2
  177.     Print "@X1F " + Left(TSTRING017(STRING008 - INTEGER004 + INTEGER003), 1) + " @X03"
  178.     :LABEL008
  179.     STRING011 = Inkey()
  180.     INTEGER007 = 0
  181.     If (STRING011 == "") Goto LABEL008
  182.     If (STRING011 == "UP") Then
  183.         If ((INTEGER004 == 1) && (INTEGER003 == 0)) Goto LABEL009
  184.         INTEGER005 = INTEGER004
  185.         INTEGER004 = INTEGER004 - 1
  186.     Endif
  187.     :LABEL009
  188.     If (STRING011 == Chr(13)) Goto LABEL012
  189.     If (Upper(STRING011) == "A") Goto LABEL014
  190.     If (Upper(STRING011) == "D") Goto LABEL015
  191.     If (STRING011 == "DOWN") Then
  192.         If ((INTEGER004 >= 19) && (INTEGER003 >= INTEGER008 - 19)) Goto LABEL010
  193.         INTEGER005 = INTEGER004
  194.         INTEGER004 = INTEGER004 + 1
  195.     Endif
  196.     :LABEL010
  197.     If ((Upper(STRING011) == "N") && (INTEGER003 < INTEGER008 - 19)) Then
  198.         INTEGER003 = INTEGER003 + 19
  199.         INTEGER004 = 1
  200.         INTEGER005 = 2
  201.         INTEGER007 = 1
  202.     Endif
  203.     If ((Upper(STRING011) == "P") && (INTEGER003 > 0)) Then
  204.         INTEGER003 = INTEGER003 - 19
  205.         INTEGER004 = 19
  206.         INTEGER007 = 1
  207.     Endif
  208.     If (STRING011 == "X") Goto LABEL030
  209.     If (STRING011 == Chr(27)) Goto LABEL030
  210.     If (INTEGER004 < 1) Then
  211.         INTEGER003 = INTEGER003 - 1
  212.         INTEGER004 = 1
  213.         INTEGER005 = 2
  214.         INTEGER007 = 1
  215.     Endif
  216.     If (INTEGER004 > 19) Then
  217.         INTEGER003 = INTEGER003 + 1
  218.         INTEGER005 = 18
  219.         INTEGER004 = 19
  220.         INTEGER007 = 1
  221.     Endif
  222.     If (INTEGER003 > INTEGER008 - 19) Then
  223.         If (INTEGER008 < 19) Then
  224.             INTEGER003 = 0
  225.             Goto LABEL011
  226.         Endif
  227.         INTEGER003 = INTEGER008 - 19
  228.         INTEGER004 = 19
  229.     Endif
  230.     :LABEL011
  231.     If (INTEGER004 + INTEGER003 > INTEGER008) Then
  232.         INTEGER004 = INTEGER008 - INTEGER003
  233.         INTEGER005 = 1
  234.     Endif
  235.     If (INTEGER003 < 0) Then
  236.         INTEGER003 = 0
  237.         INTEGER004 = 1
  238.         INTEGER005 = 2
  239.     Endif
  240.     If (INTEGER007 == 1) Goto LABEL006
  241.     Goto LABEL007
  242.     Return
  243.     :LABEL012
  244.     If (Exist(PPEPath() + "news." + TSTRING002(STRING008 - INTEGER004 + INTEGER003))) Goto LABEL013
  245.     Newlines 3
  246.     PrintLn "@X0C■ No news file found!@X07"
  247.     Wait
  248.     Goto LABEL005
  249.     :LABEL013
  250.     Cls
  251.     PrintLn "@X1F@POFF@DeltaProductions NEWS v1.3A - Viewing news                   (c) Creep&Delta/DP@X07"
  252.     Newline
  253.     DispFile PPEPath() + "NEWS." + TSTRING002(STRING008 - INTEGER004 + INTEGER003), 0
  254.     AnsiPos 1, 1
  255.     PrintLn "@X1F@POFF@DeltaProductions NEWS v1.3A - Viewing news                   (c) Creep&Delta/DP@X07"
  256.     AnsiPos 1, 23
  257.     Wait
  258.     Goto LABEL005
  259.     :LABEL014
  260.     GetUser
  261.     If (STRING010 > U_Sec) Then
  262.         Newline
  263.         PrintLn "@X0C■ YOUR ACCESS LEVEL IS TOO LOW TO ADD NEWS!@X07"
  264.     Else
  265.         Goto LABEL016
  266.     Endif
  267.     Wait
  268.     Goto LABEL005
  269.     :LABEL015
  270.     GetUser
  271.     If (STRING010 > U_Sec) Then
  272.         Newline
  273.         PrintLn "@X0C■ YOUR ACCESS LEVEL IS TOO LOW TO DELETE NEWS!@X07"
  274.     Else
  275.         TSTRING002(INTEGER009) = ""
  276.         Goto LABEL018
  277.     Endif
  278.     Wait
  279.     Goto LABEL005
  280.     :LABEL016
  281.     Cls
  282.     PrintLn "@X1F@POFF@DeltaProductions NEWS v1.3A - New news header                (c) Creep&Delta/DP@X07"
  283.     Newline
  284.     Print "@X0FH@X0Be@X03ader@X08: @X0B"
  285.     InputStr "_", STRING007, 7, 40, Mask_Ascii(), 4096
  286.     If (STRING007 == "") Goto LABEL016
  287.     Newline
  288.     DispFile PPEPath() + "disp2", 0
  289.     :LABEL017
  290.     STRING012 = Inkey()
  291.     If (Upper(STRING012) == "N") Goto LABEL016
  292.     If (Upper(STRING012) == "Q") Goto LABEL005
  293.     If (Upper(STRING012) == "Y") Goto LABEL026
  294.     Goto LABEL017
  295.     Goto LABEL026
  296.     :LABEL018
  297.     If (TSTRING002(STRING008 - INTEGER004 + INTEGER003) < 1) Goto LABEL001
  298.     If ("" == "0") Goto LABEL006
  299.     AnsiPos 1, 23
  300.     Print "                                                                             "
  301.     AnsiPos 1, 23
  302.     Print "@X0FD@X0Be@X03lete this news @X0F[@X0BY@X03/@X0BN@X08] @X08: "
  303.     InputStr "_", STRING018, 7, 1, "YyNn", 4096
  304.     If (Upper(STRING018) == "N") Then
  305.         Cls
  306.         Goto LABEL001
  307.     Endif
  308.     If (Upper(STRING018) == "Y") Then
  309.     Endif
  310.     INTEGER012 = 0
  311.     FOpen 1, PPEPath() + "news.idx", 0, 0
  312.     :LABEL019
  313.     If (Ferr(1)) Goto LABEL020
  314.     FGet 1, TSTRING014(INTEGER012)
  315.     FGet 1, TSTRING015(INTEGER012)
  316.     FGet 1, TSTRING016(INTEGER012)
  317.     INTEGER012 = INTEGER012 + 1
  318.     Goto LABEL019
  319.     :LABEL020
  320.     STRING005 = String(TSTRING002(STRING008 - INTEGER004 + INTEGER003))
  321.     If (Len(STRING005) == 1) STRING005 = "00" + STRING005
  322.     If (Len(STRING005) == 2) STRING005 = "0" + STRING005
  323.     FClose 1
  324.     FClose 2
  325.     Delete PPEPath() + "news.tmp"
  326.     FCreate 2, PPEPath() + "news.tmp", 2, 3
  327.     FOpen 1, PPEPath() + "news.idx", 0, 0
  328.     FGet 1, TSTRING014(INTEGER012)
  329.     FPutLn 2, TSTRING014(INTEGER012)
  330.     :LABEL021
  331.     If (Ferr(1)) Goto LABEL023
  332.     INTEGER012 = INTEGER012 + 1
  333.     FGet 1, TSTRING014(INTEGER012)
  334.     FGet 1, TSTRING015(INTEGER012)
  335.     FGet 1, TSTRING016(INTEGER012)
  336.     If (TSTRING015(INTEGER012) == STRING005) Goto LABEL022
  337.     FPutLn 2, TSTRING014(INTEGER012)
  338.     FPutLn 2, TSTRING015(INTEGER012)
  339.     FPutLn 2, TSTRING016(INTEGER012)
  340.     :LABEL022
  341.     Goto LABEL021
  342.     :LABEL023
  343.     FClose 1
  344.     FClose 2
  345.     Delete PPEPath() + "news.idx"
  346.     FOpen 1, PPEPath() + "news.tmp", 0, 0
  347.     FCreate 2, PPEPath() + "news.idx", 2, 0
  348.     :LABEL024
  349.     If (Ferr(1)) Goto LABEL025
  350.     FGet 1, TSTRING014(INTEGER012)
  351.     If (!(TSTRING014(INTEGER012) == "")) FPutLn 2, TSTRING014(INTEGER012)
  352.     Goto LABEL024
  353.     :LABEL025
  354.     FClose 1
  355.     FClose 2
  356.     Delete PPEPath() + "news.tmp"
  357.     Delete PPEPath() + "news." + STRING005
  358.     Goto LABEL001
  359.     :LABEL026
  360.     Cls
  361.     PrintLn "@X1FDeltaProductions NEWS v1.3A - Enter your news               (c) Creep&Delta/DP@X07"
  362.     DispFile PPEPath() + "disp1", 0
  363.     For INTEGER010 = 1 To 9999
  364.         InputStr "_", TSTRING013(INTEGER010), 7, 79, Mask_Ascii() + Mask_AlNum(), 4096 + 64
  365.         If (Upper(TSTRING013(INTEGER010)) == "/S") Break
  366.         If (Upper(TSTRING013(INTEGER010)) == "/A") Goto LABEL029
  367.     Next
  368.     Newline
  369.     PrintLn "@X0FA@X0Bd@X03ding header to index file@X08...@X07"
  370.     FClose 1
  371.     FOpen 1, PPEPath() + "news.idx", 0, 0
  372.     FGet 1, TSTRING001(INTEGER001)
  373.     :LABEL027
  374.     If (Ferr(1)) Goto LABEL028
  375.     INTEGER001 = INTEGER001 + 1
  376.     FGet 1, TSTRING001(INTEGER001)
  377.     If (TSTRING001(INTEGER001) == "") Goto LABEL028
  378.     FGet 1, INTEGER019
  379.     FGet 1, TSTRING003(INTEGER001)
  380.     Goto LABEL027
  381.     :LABEL028
  382.     FClose 1
  383.     STRING008 = String(INTEGER019 + 1)
  384.     If (Len(STRING008) == 1) STRING008 = "00" + STRING008
  385.     If (Len(STRING008) == 2) STRING008 = "0" + STRING008
  386.     FAppend 1, PPEPath() + "news.idx", 0, 0
  387.     FPutLn 1, STRING007
  388.     FPutLn 1, STRING008
  389.     FPutLn 1, STRING009
  390.     FClose 1
  391.     INTEGER010 = INTEGER010 - 1
  392.     Newline
  393.     PrintLn "@X0FS@X0Ba@X03ving news file@X08...@X07"
  394.     FOpen 1, PPEPath() + "news." + STRING008, 2, 0
  395.     INTEGER011 = 0
  396.     For INTEGER011 = 1 To INTEGER010
  397.         FPutLn 1, TSTRING013(INTEGER011)
  398.     Next
  399.     FClose 1
  400.     Goto LABEL001
  401.     :LABEL029
  402.     Newline
  403.     PrintLn "@X0CABORTED!@X07"
  404.     Goto LABEL001
  405.     :LABEL030
  406.     PrintLn "@PON@"
  407.     Cls
  408.     End
  409.  
  410. ;------------------------------------------------------------------------------
  411. ;
  412. ; Usage report (before postprocessing)
  413. ;
  414. ; ■ Statements used :
  415. ;
  416. ;    1       End
  417. ;    7       Cls
  418. ;    4       Wait
  419. ;    80      Goto 
  420. ;    87      Let 
  421. ;    16      Print 
  422. ;    14      PrintLn 
  423. ;    58      If 
  424. ;    4       DispFile 
  425. ;    3       FCreate 
  426. ;    8       FOpen 
  427. ;    1       FAppend 
  428. ;    12      FClose 
  429. ;    19      FGet 
  430. ;    10      FPutLn 
  431. ;    2       GetUser
  432. ;    4       Delete 
  433. ;    3       InputStr 
  434. ;    1       Return
  435. ;    9       Newline
  436. ;    1       Newlines 
  437. ;    16      AnsiPos 
  438. ;    3       SPrintLn 
  439. ;
  440. ;
  441. ; ■ Functions used :
  442. ;
  443. ;    100     +
  444. ;    28      -
  445. ;    37      ==
  446. ;    1       <>
  447. ;    11      <
  448. ;    5       <=
  449. ;    6       >
  450. ;    10      >=
  451. ;    34      !
  452. ;    15      &&
  453. ;    4       ||
  454. ;    6       Len(
  455. ;    11      Upper()
  456. ;    12      Left()
  457. ;    5       Ferr()
  458. ;    2       Chr()
  459. ;    1       Date()
  460. ;    1       U_LDate()
  461. ;    2       Year()
  462. ;    2       Month()
  463. ;    2       Day()
  464. ;    2       Inkey()
  465. ;    3       String()
  466. ;    1       Mask_AlNum()
  467. ;    2       Mask_Ascii()
  468. ;    22      PPEPath()
  469. ;    2       Exist()
  470. ;
  471. ;------------------------------------------------------------------------------
  472. ;
  473. ; Analysis flags : No flag
  474. ;
  475. ;------------------------------------------------------------------------------
  476. ;
  477. ; Postprocessing report
  478. ;
  479. ;    4       For/Next
  480. ;    0       While/EndWhile
  481. ;    20      If/Then or If/Then/Else
  482. ;    0       Select Case
  483. ;
  484. ;------------------------------------------------------------------------------
  485. ;                 AEGiS Corp - Break the routines, code against the machines!
  486. ;------------------------------------------------------------------------------
  487.